﻿
'write a serial of bytes to a cluster id, and response the cluster id
'read a serial of bytes from cluster id
'append a serial of bytes to a cluster id, and response cluster id
'delete a cluster id

Imports std

Public Class fceslite(Of THREADSAFE As _boolean)
    Public Const MIN_CLUSTER_LENGTH As UInt16 = DISK_CLUSTER_SIZE - cluster.CLUSTER_STRUCT_SIZE
    Public Const DISK_CLUSTER_SIZE As UInt16 = 512
    Private Shared ts As Boolean = True
    Private cs As vector(Of cluster) = Nothing
    Private vd As virtdisk = Nothing
    Private sl As sequentialLock = Nothing
    Private maxDiskOffset As Int64 = 0

    Shared Sub New()
        ts = +(alloc(Of THREADSAFE)())
    End Sub

    Private Sub New()
        cs = New vector(Of cluster)()
        If ts Then
            sl = New sequentialLock()
        End If
    End Sub

    Private Sub lock()
        If ts Then
            sl.wait()
        End If
    End Sub

    Private Sub unlock()
        If ts Then
            sl.release()
        End If
    End Sub

    Private Function sizeofImpl(ByVal id As Int64, ByRef size As UInt64) As Boolean
        If Not cs.availableIndex(id) Then
            Return False
        End If
        size = get_cluster(id).usedSize()
        Return True
    End Function

    Public Function sizeof(ByVal id As Int64, ByRef size As UInt64) As Boolean
        Dim rtn As Boolean
        lock()
        rtn = sizeofImpl(id, size)
        unlock()
        Return rtn
    End Function

    Public Function virtdisk_size() As Int64
        Return maxDiskOffset
    End Function

    Private Function openImpl(ByVal filename As String) As Boolean
        vd = New virtdisk()
        If Not vd.open(filename) OrElse Not vd.valid() Then
            raiseError("cannot open virtdisk in file " + filename, errorHandle.errorType.exclamation)
            Return False
        End If

        Dim start As Int64 = 0
        While True
            Dim c As cluster = Nothing
            c = New cluster()
            If Not c.initial(vd, start) Then
                Exit While
            Else
                If cs.size() <> c.clusterId Then
                    raiseError("caught a cluster empty slot in file " + filename + ", ignore following data.", _
                               errorHandle.errorType.warning)
                    Return False
                End If
                cs.push_back(c)
            End If
        End While
        maxDiskOffset = start
        Return True
    End Function

    Public Function open(ByVal filename As String) As Boolean
        If Not vd Is Nothing Then
            Return False
        End If
        Dim rtn As Boolean
        lock()
        rtn = openImpl(filename)
        unlock()
        Return rtn
    End Function

    Private Function closeImpl() As Boolean
        vd.close()
        vd = Nothing
        Return True
    End Function

    Public Function close() As Boolean
        If vd Is Nothing OrElse Not vd.valid() Then
            Return False
        End If
        Dim rtn As Boolean
        lock()
        rtn = closeImpl()
        unlock()
        Return rtn
    End Function

    Private Function get_cluster(ByVal id As Int64) As cluster
        If isdebugmode() Then
            assert(cs.availableIndex(id))
            assert(cs(id).clusterId = id)
            If id < cs.size() - 1 Then
                assert(cs(id).diskoffset + cluster.CLUSTER_STRUCT_SIZE + cs(id).length = cs(id + 1).diskoffset)
            End If
        End If
        Return cs(id)
    End Function

    Private Function readImpl(ByVal c As cluster, ByRef bts As bytes) As Boolean
        Return Not c.free() AndAlso c.read(vd, bts)
    End Function

    Private Function readImpl(ByVal id As Int64, ByRef bts As bytes) As Boolean
        If Not cs.availableIndex(id) Then
            Return False
        End If
        Return readImpl(get_cluster(id), bts)
    End Function

    Public Function read(ByVal id As Int64, ByRef bts As bytes) As Boolean
        If vd Is Nothing OrElse Not vd.valid() Then
            Return False
        End If
        Dim rtn As Boolean
        lock()
        rtn = readImpl(id, bts)
        unlock()
        Return rtn
    End Function

    Private Shared Function chooseClusterSize(ByVal minsize As Int64) As Int64
        Dim len As UInt64
        'input bytes size * 1.5
        len = minsize + (minsize >> 1)
        If len <= MIN_CLUSTER_LENGTH Then
            'at least MIN_CLUSTER_SIZE
            len = MIN_CLUSTER_LENGTH
        Else
            Dim m As UInt16
            m = len Mod DISK_CLUSTER_SIZE
            If m < MIN_CLUSTER_LENGTH Then
                len += MIN_CLUSTER_LENGTH - m
            ElseIf m > MIN_CLUSTER_LENGTH Then
                len += MIN_CLUSTER_LENGTH + DISK_CLUSTER_SIZE - m
            End If
        End If

        If isdebugmode() Then
            assert((len + cluster.CLUSTER_STRUCT_SIZE) Mod DISK_CLUSTER_SIZE = 0)
        End If
        Return len
    End Function

    'write to an existing free cluster or a new cluster
    Private Function writeImpl(ByRef id As Int64, ByVal bts As bytes) As Boolean
        For i As Int64 = 0 To cs.size() - 1
            If cs(i).free() AndAlso cs(i).length >= bts.size() Then
                id = i
                Return cs(i).write(vd, bts)
            End If
        Next

        'no valid cluster now, create a new one
        Dim c As cluster = Nothing
        c = New cluster()
        c.diskoffset = maxDiskOffset
        If isdebugmode() AndAlso cs.size() > 0 Then
            Dim cl As cluster = Nothing
            cl = get_cluster(cs.size() - 1)
            assert(maxDiskOffset = cl.diskoffset + cluster.CLUSTER_STRUCT_SIZE + cl.length)
        End If
        c.clusterId = cs.size()
        c.length = chooseClusterSize(bts.size())
        Dim temp As Int64
        If c.write(vd, bts, temp) Then
            maxDiskOffset = temp
            cs.push_back(c)
            id = c.clusterId
            Return True
        Else
            Return False
        End If
    End Function

    Private Delegate Function cwa_d(ByVal c As cluster, ByVal vd As virtdisk, ByVal bts As bytes) As Boolean
    Private Delegate Function cr_d(ByVal c As cluster, ByVal vd As virtdisk, _
                                   ByRef o As bytes, ByVal i As bytes) As Boolean

    Private Shared Function _cr(ByRef o As bytes, ByVal i As bytes) As Boolean
        o = i
        Return True
    End Function

    Private Function _aw(ByVal id As Int64, ByVal bts As bytes, ByRef rid As Int64, _
                         ByVal cwa As cwa_d, Optional ByVal cr As cr_d = Nothing) As Boolean
        If cs.availableIndex(id) Then
            Dim c As cluster = Nothing
            c = get_cluster(id)
            If cwa(c, vd, bts) Then
                rid = id
                Return True
                'do not have enough space
            ElseIf c.free() Then
                Return writeImpl(rid, bts)
            Else
                'still have data in old cluster
                Dim w As bytes = Nothing
                Return ((cr Is Nothing AndAlso _cr(w, bts)) OrElse cr(c, vd, w, bts)) AndAlso _
                       deleteCluster(c) AndAlso writeImpl(rid, w)
            End If
        Else
        Return writeImpl(rid, bts)
        End If
    End Function

    Private Shared Function appendImpl(ByVal c As cluster, ByVal vd As virtdisk, ByVal bts As bytes) As Boolean
        Return c.append(vd, bts)
    End Function

    Private Function appendRead(ByVal c As cluster, ByVal vd As virtdisk, _
                                ByRef o As bytes, ByVal i As bytes) As Boolean
        Dim tmp As bytes = Nothing
        If readImpl(c, tmp) Then
            o = tmp + i
            Return True
        Else
            Return False
        End If
    End Function

    Private Function appendImpl(ByVal id As Int64, ByVal bts As bytes, ByRef rid As Int64) As Boolean
        Return _aw(id, bts, rid, AddressOf appendImpl, AddressOf appendRead)
    End Function

    Public Function append(ByVal id As Int64, ByVal bts As bytes, ByRef rid As Int64) As Boolean
        If vd Is Nothing OrElse Not vd.valid() OrElse bts Is Nothing Then
            Return False
        End If
        Dim rtn As Boolean
        lock()
        rtn = appendImpl(id, bts, rid)
        unlock()
        Return rtn
    End Function

    Private Shared Function writeImpl(ByVal c As cluster, ByVal vd As virtdisk, ByVal bts As bytes) As Boolean
        Return c.write(vd, bts)
    End Function

    Private Function writeImpl(ByVal id As Int64, ByVal bts As bytes, ByRef rid As Int64) As Boolean
        Return _aw(id, bts, rid, AddressOf writeImpl)
    End Function

    Public Function write(ByVal id As Int64, ByVal bts As bytes, ByRef rid As Int64) As Boolean
        If vd Is Nothing OrElse Not vd.valid() OrElse bts Is Nothing Then
            Return False
        End If
        Dim rtn As Boolean
        lock()
        rtn = writeImpl(id, bts, rid)
        unlock()
        Return rtn
    End Function

    Private Function deleteLast() As Boolean
        Dim i As Int64
        For i = cs.size() - 2 To 0 Step -1
            If Not cs(i).free() Then
                'find the last cluster should not be removed
                Exit For
            End If
        Next
        inc(i)
        Return vd.erase(cs(i).diskoffset) AndAlso eva(maxDiskOffset, cs(i).diskoffset) AndAlso cs.erase(i, cs.size())
    End Function

    Private Function deleteCluster(ByVal c As cluster) As Boolean
        Return Not c.free() AndAlso c.delete(vd)
    End Function

    Private Function deleteImpl(ByVal id As Int64) As Boolean
        If Not cs.availableIndex(id) Then
            Return False
        ElseIf id = cs.size() - 1 Then
            Return deleteLast()
        Else
            Return deleteCluster(get_cluster(id))
        End If
    End Function

    Public Function delete(ByVal id As Int64) As Boolean
        If vd Is Nothing OrElse Not vd.valid() Then
            Return False
        End If
        Dim rtn As Boolean
        lock()
        rtn = deleteImpl(id)
        unlock()
        Return rtn
    End Function

    Private Function flushImpl() As Boolean
        Return vd.flush()
    End Function

    Public Function flush() As Boolean
        If vd Is Nothing OrElse Not vd.valid() Then
            Return False
        End If
        Dim rtn As Boolean
        lock()
        rtn = flushImpl()
        unlock()
        Return rtn
    End Function

    Public Sub New(ByVal filename As String)
        Me.New()
        open(filename)
    End Sub
End Class

Public Class fceslite
    Inherits fceslite(Of _true)

    Public Sub New(ByVal filename As String)
        MyBase.New(filename)
    End Sub
End Class